home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / MacOberon / MacOberon (core) / MacOberon 2.0 / MacOberon 2.0.rsrc / .ObP_32767 < prev    next >
Encoding:
Text File  |  1991-02-15  |  6.2 KB  |  226 lines
  1. %!
  2. %    MacOberon, Michael Franz, ETHZ, 15.2.91
  3.  
  4. /m {moveto} def
  5. /s {show} def
  6.  
  7. /l
  8.   { /y0 exch def
  9.     /x0 exch def
  10.     newpath
  11.     moveto
  12.     x0 y0 lineto
  13.     0 setlinewidth
  14.     stroke
  15.   } def
  16.  
  17. /c
  18.   { /pb exch def
  19.     /pa exch def
  20.     newpath
  21.     gsave
  22.     translate
  23.     1 pb pa div scale
  24.     0 0 pa 0 360 arc
  25.     0 setlinewidth
  26.     stroke
  27.     grestore
  28.   } def
  29.  
  30. /maxwh
  31.   { pw ph gt {/max pw def} {/max ph def} ifelse
  32.   } def
  33.  
  34. /shade
  35.   { col 0 eq {1 setgray} if
  36.     col 1 eq {0.875 setgray} if
  37.     col 2 eq {0.75 setgray} if
  38.     col 3 eq {0.50 setgray} if
  39.     col 4 eq {0.25 setgray} if
  40.     col 5 eq {0 setgray} if
  41.     fill
  42.   } def
  43.  
  44. /texture
  45.   { gsave
  46.     clip
  47.     newpath
  48.     col 6 eq
  49.       { px py ph add moveto
  50.         maxwh
  51.         max 10 idiv 1 add
  52.           { max max rlineto
  53.             max neg dup 20 sub rmoveto
  54.           } repeat
  55.       } if
  56.     col 7 eq
  57.       { px py moveto
  58.         maxwh
  59.         max 10 idiv 1 add
  60.           { max neg max rlineto
  61.             max 20 add max neg rmoveto
  62.           } repeat
  63.       } if
  64.     col 8 eq
  65.       { px py moveto
  66.         pw 15 idiv 1 add
  67.           { 0 ph rlineto
  68.             15 ph neg rmoveto
  69.           } repeat
  70.      } if
  71.     col 9 eq
  72.       { px py moveto
  73.         ph 15 idiv 1 add
  74.           { pw 0 rlineto
  75.             pw neg 15 rmoveto
  76.           } repeat
  77.      } if
  78.     0 setlinewidth
  79.     stroke
  80.     grestore
  81.   } def
  82.  
  83. /b
  84.   { /col exch def
  85.     /ph exch def
  86.     /pw exch def
  87.     /py exch def
  88.     /px exch def
  89.     newpath
  90.     px py moveto
  91.     pw 0 rlineto
  92.     0 ph rlineto
  93.     pw neg 0 rlineto
  94.     closepath
  95.     col 6 lt {shade} {texture} ifelse
  96.   } def
  97.  
  98. /i
  99.   { /mode exch def
  100.     /ph exch def
  101.     /pw exch def
  102.     /py exch def
  103.     /px exch def
  104.     /picstr 256 string def
  105.     /nofbytes pw 7 add 8 idiv ph mul def
  106.     gsave
  107.     px py translate
  108.     pw 2 mul ph 2 mul  scale
  109.     pw ph 1 [pw 0 0 ph 0 0]
  110.       {nofbytes 256 ge
  111.         { currentfile picstr readhexstring
  112.           /nofbytes nofbytes 256 sub def
  113.           pop
  114.         }
  115.         { /picstr nofbytes string def
  116.           currentfile picstr readhexstring
  117.           pop
  118.           /nofbytes 0 def
  119.         } ifelse
  120.       } image
  121.     grestore
  122.   } def
  123.  
  124. /init
  125.   { .23 -.23 scale
  126.     100 50 translate
  127.   } def
  128.  
  129. /p
  130.   { {copypage} repeat
  131.   } def
  132.  
  133. % encode Encode Special Oberon-Characters in Dictionary  newfontName oldFontName -> - 
  134. /encode
  135.   { findfont dup length dict /newdict exch def
  136.     {1 index /FID ne
  137.       {newdict 3 1 roll put} {pop pop} ifelse
  138.     } forall
  139.     
  140.     /newencoding newdict /Encoding get aload pop 256 array astore def
  141.     /Adieresis /Odieresis /Udieresis /adieresis /odieresis /udieresis
  142.     /acircumflex /ecircumflex /icircumflex /ocircumflex /ucircumflex
  143.     /agrave /egrave /igrave /ograve /ugrave /eacute /edieresis /idieresis
  144.     /ccedilla /aacute /ntilde
  145.     newencoding 128 22 getinterval astore pop
  146.     newdict /Encoding newencoding put
  147.     newdict definefont pop
  148.   } def
  149.  
  150. /map
  151.   { ofnt eq 
  152.      {dup FontDirectory exch known not {dup 2 index encode} if
  153.       findfont 2 index scalefont setfont pop pop} {pop pop pop} ifelse
  154.   } def
  155.  
  156. /f
  157.   { /ofnt exch def
  158.     /Helvetica findfont 41 scalefont setfont    % default font
  159.     % Format der Font-Mappings :
  160.     %     Scaling-Factor | Original-Postscript-Fontname | New-Oberon-Fontname |  (Oberon-System-Fontname) | map
  161.  
  162.     30 /Helvetica         /Oberon-Helvetica         (Syntax8.Scn.Fnt)     map
  163.     30 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax8i.Scn.Fnt) map
  164.     30 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax8b.Scn.Fnt) map
  165.  
  166.     37 /Helvetica         /Oberon-Helvetica         (Syntax10.Scn.Fnt)     map
  167.     37 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax10i.Scn.Fnt) map
  168.     37 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax10b.Scn.Fnt) map
  169.  
  170.     44 /Helvetica         /Oberon-Helvetica         (Syntax12.Scn.Fnt)     map
  171.     44 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax12i.Scn.Fnt) map
  172.     44 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax12b.Scn.Fnt) map
  173.  
  174.     51 /Helvetica         /Oberon-Helvetica         (Syntax14.Scn.Fnt)     map
  175.     51 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax14i.Scn.Fnt) map
  176.     51 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax14b.Scn.Fnt) map
  177.  
  178.     59 /Helvetica         /Oberon-Helvetica         (Syntax16.Scn.Fnt)     map
  179.     59 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax16i.Scn.Fnt) map
  180.     59 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax16b.Scn.Fnt) map
  181.  
  182.     74 /Helvetica         /Oberon-Helvetica         (Syntax20.Scn.Fnt)     map
  183.     74 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax20i.Scn.Fnt) map
  184.     74 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax20b.Scn.Fnt) map
  185.  
  186.     88 /Helvetica         /Oberon-Helvetica         (Syntax24Scn.Fnt)     map
  187.     88 /Helvetica-Oblique /Oberon-Helvetica-Oblique (Syntax24i.Scn.Fnt) map
  188.     88 /Helvetica-Bold    /Oberon-Helvetica-Bold    (Syntax24b.Scn.Fnt) map
  189.  
  190.     %
  191.  
  192.     30 /Times         /Oberon-Times         (Times8.Scn.Fnt)     map
  193.     30 /Times-Oblique /Oberon-Times-Oblique (Times8i.Scn.Fnt) map
  194.     30 /Times-Bold    /Oberon-Times-Bold    (Times8b.Scn.Fnt) map
  195.  
  196.     37 /Times         /Oberon-Times         (Times10.Scn.Fnt)     map
  197.     37 /Times-Oblique /Oberon-Times-Oblique (Times10i.Scn.Fnt) map
  198.     37 /Times-Bold    /Oberon-Times-Bold    (Times10b.Scn.Fnt) map
  199.  
  200.     44 /Times         /Oberon-Times         (Times12.Scn.Fnt)     map
  201.     44 /Times-Oblique /Oberon-Times-Oblique (Times12i.Scn.Fnt) map
  202.     44 /Times-Bold    /Oberon-Times-Bold    (Times12b.Scn.Fnt) map
  203.  
  204.     51 /Times         /Oberon-Times         (Times14.Scn.Fnt)     map
  205.     51 /Times-Oblique /Oberon-Times-Oblique (Times14i.Scn.Fnt) map
  206.     51 /Times-Bold    /Oberon-Times-Bold    (Times14b.Scn.Fnt) map
  207.  
  208.     59 /Times         /Oberon-Times         (Times16.Scn.Fnt)     map
  209.     59 /Times-Oblique /Oberon-Times-Oblique (Times16i.Scn.Fnt) map
  210.     59 /Times-Bold    /Oberon-Times-Bold    (Times16b.Scn.Fnt) map
  211.  
  212.     74 /Times         /Oberon-Times         (Times20.Scn.Fnt)     map
  213.     74 /Times-Oblique /Oberon-Times-Oblique (Times20i.Scn.Fnt) map
  214.     74 /Times-Bold    /Oberon-Times-Bold    (Times20b.Scn.Fnt) map
  215.  
  216.     88 /Times         /Oberon-Times         (Times24Scn.Fnt)     map
  217.     88 /Times-Oblique /Oberon-Times-Oblique (Times24i.Scn.Fnt) map
  218.     88 /Times-Bold    /Oberon-Times-Bold    (Times24b.Scn.Fnt) map
  219.  
  220.     30 /Courier           /Oberon-Courier           (List-Font) map
  221.  
  222.   } def
  223.  
  224. % --- end Header
  225.  
  226.